module Salsa.Parser where 
import Salsa.Types
import Salsa.Lexer as L
import Text.ParserCombinators.Parsec hiding (spaces)
import Monad
import Control.Monad.Error

readExps :: String -> ThrowsError [Exp]
readExps = makeReader parseExps

readExp :: String -> ThrowsError Exp
readExp = makeReader parseExp

makeReader :: GenParser Char () a -> String -> ThrowsError a
makeReader parser str = case parse parser "" str of
                          Left err -> throwError $ Parser err
                          Right val -> return val

parseExps :: GenParser Char () [Exp]
parseExps = do xs <- many1 parseExp
               skipMany space
               eof
               return xs

parseExp :: GenParser Char () Exp
parseExp = skipMany space >>
           (parseSymbol 
            <|> parseString 
            <|> parseInt 
            <|> parseQuoted
            <|> parseList) <?> "an expression"

parseSymbol :: GenParser Char () Exp
parseSymbol = do s <- L.symbol <?> "a symbol"
                 return $ case s of
                            "#t" -> Bool True
                            "#f" -> Bool False
                            otherwise -> Symbol s

parseString :: GenParser Char () Exp
parseString = do s <- L.string <?> "a string"
                 return $ String s

parseInt :: GenParser Char () Exp
parseInt = do i <- L.integer <?> "an integral number"
              return $ Integer i

parseList :: GenParser Char () Exp
parseList = do opParen
               head <- many parseExp 
               tail <- parseTail
               clParen <?> "a list"
               return $ case tail of
                          Empty ->  List head
                          Dotted tail -> DotList head tail

data Tail = Empty | Dotted Exp

parseTail :: GenParser Char () Tail
parseTail = (try dotList) <|> emptyList

dotList :: GenParser Char () Tail
dotList = do dot 
             x <- parseExp
             return $ Dotted x

emptyList :: GenParser Char () Tail
emptyList = return Empty

parseQuoted :: GenParser Char () Exp
parseQuoted = do quote
                 x <- parseExp
                 return $ List [Symbol "quote", x]